COMMENT ⊗   VALID 00015 PAGES 
RECORD PAGE   DESCRIPTION
 00001 00001
 00003 00002		THIS IS THE HAND/EYE UTILITY PACKAGE
 00007 00003	⊃	MISC. PROCEDURES
 00011 00004	⊃	edge follower response driver
 00015 00005	⊃	edge follower driver
 00017 00006	⊃   Curve and compact driver
 00022 00007	⊃	simple driver
 00024 00008	⊃	fine driver, just like curve
 00027 00009	⊃	verifier driver
 00030 00010	⊃	OLD COLOR DRIVER
 00032 00011	⊃	NEW COLOR DRIVER
 00036 00012	⊃	DISPLAY PROGRAMS
 00040 00013	⊃	delete display
 00042 00014	⊃	this is the job setup program
 00045 00015	⊃	this is the initialization routine for
 00047 ENDMK
⊗;
COMMENT		THIS IS THE HAND/EYE UTILITY PACKAGE;

REQUIRE 200 PNAMES;
REQUIRE 200 NEW_ITEMS;
REQUIRE "PREAMB.SAI[SYS,HE]" SOURCE_FILE;
REQUIRE "DPYSUB.HDR[SYS,HE]" SOURCE_FILE;
REQUIRE "HELIB.REL[1,3]" LIBRARY;
EXTERNAL PROCEDURE FADCHG(REAL X,Y; PROCEDURE PROC);
EXTERNAL PROCEDURE FRDCHG(REAL X,Y; PROCEDURE PROC);
FORWARD SIMPLE STRING PROCEDURE PN(ITEMVAR X);
FORWARD SIMPLE PROCEDURE REJ_OBJ(SET BLOBS);
FORWARD SIMPLE PROCEDURE PROCESS_RESPONSE(STRING NAME; BOOLEAN FLAG);
FORWARD PROCEDURE U_ALL(REFERENCE SET FOO; INTEGER B);
FORWARD PROCEDURE DISP_DEL(SET X);
INTEGER ITEM U_DISP;
ITEMVAR TEMP;

DEFINE U_DEL(A)="FOREACH TEMP|GLOBAL A≡TEMP DO BEGIN;GLOBAL ERASE A≡TEMP;
	GLOBAL DELETE(TEMP);END", ⊃="COMMENT", U_C="&('15&'12)",
	U_OUT="IF TYP_II THEN OUTSTR(", U_EOM=" U_C)", U_GD="GLOBAL DATUM";

⊃	table of defined names and flags in second segment;

DEFINE U_DEFMAX="13";
PRELOAD_WITH "EDG", "CUR", "SIM", "CAM", "VER", "COL", "GUN", "EYE", "HAND",
	"MOVE", "SEG", "REC", "HLE";
SAFE STRING ARRAY U_DEFNAMES[1:U_DEFMAX];

⊃	status bits for datum of blobs;

DEFINE U_CLOSE="'10", U_EDGE="'20", U_CURV="'40", U_REC="'100",
	U_SIMP="'200" , U_FINE="'2000";

SET U_BLOB;	⊃	all known blobs;
SET U_OBJ;	⊃	all known objects;
SET U_EDGBLB;	⊃	'find' output from edge follower;
SET U_CURBLB;	⊃	'fit' output from edge follower;
SET U_COMP;	⊃	ALL COMPACTED OBJECTS

⊃	the sets of blobs and corresponding objects;

DEFINE U_BOMAX="20";
INTEGER U_BOINDEX;
SAFE SET ARRAY U_BLOBS, U_OBJS[1:U_BOMAX];

STRING U_NAME;		⊃	last response name from edge follower;
INTEGER U_STATUS;	⊃	last status from edge follower;
INTEGER ITEMVAR U_ARG;	⊃	last blob item from edge follower;

⊃	possible response names from the edge follower;

DEFINE U_RESMAX="6";
PRELOAD_WITH "FIND", "REJECT", "FINE", "FIT", "RELOOK", "COMPACT";
SAFE STRING ARRAY U_RESNAM[1:U_RESMAX];

⊃	control bits for message procedures;

DEFINE DSEND="1", DWAIT="2", DKILL="4", DSOURCE="'10", DDEST="'20",
	DNAME="'40", DWAITM="'100", DACT="'200", DACK="'400";

⊃	counters for blob, face,  and object pname generation;

INTEGER U_BCNT, U_OCNT, U_FCNT;

⊃	set of items to be deleted;

SET REJ_ITEMS;
⊃	MISC. PROCEDURES;

⊃	eliminates blobs associated with set containing foo if set is
	empty after foo is removed;

SIMPLE PROCEDURE U_ELIM(INTEGER ITEMVAR FOO);
	BEGIN INTEGER I;
	FOR I←1 STEP 1 UNTIL U_BOINDEX DO IF FOOεU_OBJS[I] THEN
		BEGIN
		IF LENGTH(U_OBJS[I])>1 THEN REMOVE FOO FROM U_OBJS[I] ELSE
			BEGIN
			U_OBJS[I] ← PHI;
			REJ_ITEMS ← REJ_ITEMS∪U_BLOBS[I];
			END;
		RETURN;
		END;
	END;

⊃	output a set;
	
SIMPLE STRING PROCEDURE U_SETOUT(SET FOO);
	BEGIN STRING X;
	X ← NULL;
	WHILE LENGTH(FOO) DO X←X&" "&PN(LOP(FOO));
	RETURN(" {"&X&"} ");
	END;

⊃	print name generator
	The first argument is the item, the second is the prefix,
		and the third is the count;

SIMPLE PROCEDURE U_PNGEN(ITEMVAR A; STRING PRE; REFERENCE INTEGER CNT);
	BEGIN INTEGER I,J;
	GETFORMAT(I,J);
	SETFORMAT(0,0);
	NEW_PNAME(A,PRE&CVS(CNT←CNT+1));
	SETFORMAT(I,J);
	END;

⊃	returns the print name of the argument if it exists,
	the octal item number otherwise;

SIMPLE STRING PROCEDURE PN(ITEMVAR X);
	BEGIN STRING FOO;
	BOOLEAN FLAG;
	INTEGER I, J;
	GETFORMAT(I,J);
	SETFORMAT(0,0);
	FOO ← CVIS(X,FLAG);
	IF FLAG THEN FOO ← CVS(CVN(X));
	SETFORMAT(I,J);
	RETURN(FOO);
	END;

⊃	procedure removes item in argument from internal structures;

SIMPLE PROCEDURE U_RJEC(INTEGER ITEMVAR A);
	BEGIN INTEGER I;
	IF AεU_BLOB THEN
		BEGIN "BLOBS"
		U_GD(A) ← 0;
		REMOVE A FROM U_BLOB;
		FOR I←1 STEP 1 UNTIL U_BOINDEX DO
			IF AεU_BLOBS[I] THEN REMOVE A FROM U_BLOBS[I];
		END "BLOBS" ELSE BEGIN "OBJS"
		U_ELIM(A);
		IF AεU_OBJ THEN REMOVE A FROM U_OBJ;
		IF AεU_COMP THEN
			BEGIN
			REJ_ITEMS ← REJ_ITEMS ∪ {A};
			REMOVE A FROM U_COMP;
			END;
		END "OBJS";
	END;

⊃	if set FOO contains all items in U_BLOB which do not have bit B on
	and has over 1 item, change to ALL;

PROCEDURE U_ALL(REFERENCE SET FOO; INTEGER B);
	IF ¬(EVERYεFOO) THEN
		BEGIN SET TEMP;
		INTEGER ITEMVAR BLOB;
		TEMP ← U_BLOB-FOO;
		FOREACH BLOB|BLOBεTEMP∧(U_GD(BLOB) LAND B) DO
			REMOVE BLOB FROM TEMP;
		IF ¬LENGTH(TEMP)∧LENGTH(FOO)>1 THEN FOO ← {EVERY};
		END;
⊃	edge follower response driver;

SIMPLE PROCEDURE PROCESS_RESPONSE(STRING NAME; BOOLEAN FLAG);
	WHILE TRUE DO
		BEGIN INTEGER MESS;
		U_OUT "WAITING FOR RESPONSE "&NAME&
			(IF ¬FLAG THEN " EVERY" ELSE NULL) U_EOM;
		MESS ← GET_ENTRY(DSOURCE+DDEST+DNAME+DWAITM,"EDGE","II",
			"RESPONSE");
		QUEUE(DACT+DACK, MESS);
		IF EQU(NAME,U_NAME) THEN IF EQU(NAME,"FIND") THEN
			BEGIN IF U_STATUS=-1 THEN DONE; END ELSE
			IF FLAG∨(U_STATUS=-1∧U_ARG=NIL) THEN DONE;
		END;

⊃	edge follower response decoder (see edge follower documentation
	for details);

MESSAGE PROCEDURE RESPONSE(STRING N; INTEGER A, S);
	BEGIN INTEGER I;
	U_ARG ← CVI(A);
	U_NAME ← N;
	U_STATUS ← S;
	IF ¬IFGLOBAL(U_ARG)∨(U_ARG=NIL∧S>0) THEN
		BEGIN
		OUTSTR("IGL RESPONSE FROM EDGE "&CVOS(A)&"   "&CVOS(S) U_C);
		U_ARG ← NIL;
		RETURN;
		END;
	FOR I←1 STEP 1 UNTIL U_RESMAX DO IF EQU(N,U_RESNAM[I]) THEN DONE;
	IF I>U_RESMAX THEN
		BEGIN
		OUTSTR("UNKNOWN RESPONSE FROM EDGE - "&N U_C);
		U_NAME ← NULL;
		RETURN;
		END;
	IF U_ARG=NIL THEN RETURN;
	CASE (I-1) OF
		BEGIN "CASE"

		IF S≥0 THEN
			BEGIN "FIND"
			IF S LAND (-1⊗'107) THEN
				BEGIN
				OUTSTR("FUNNY STATUS FROM FIND "&
					CVOS(U_STATUS) U_C);
				S ← -1;
				RETURN;
				END;
			PUT U_ARG IN U_EDGBLB;
			U_STATUS ← U_STATUS LAND 7;
			IF ¬(S LAND 64) THEN U_STATUS←U_STATUS LOR U_CLOSE;
			U_GD(U_ARG)←(U_GD(U_ARG) LAND (-1⊗U_CURV))
				LOR (U_STATUS+U_EDGE);
			IF ¬(U_ARGεU_BLOB) THEN
				BEGIN
				PUT U_ARG IN U_BLOB;
				U_PNGEN(U_ARG,"BLOB_", U_BCNT);
				END;
			END "FIND";

		IF ¬U_STATUS THEN U_RJEC(U_ARG);	⊃	reject;

		IF ¬U_STATUS THEN U_GD(U_ARG)←U_GD(U_ARG) LOR U_FINE;

		IF S<0 THEN
			BEGIN
			U_RJEC(U_ARG);
			GLOBAL DELETE(U_ARG);
			END ELSE BEGIN "FIT"
			PUT U_ARG IN U_CURBLB;
			U_GD(U_ARG)←U_GD(U_ARG) LOR
				(IF S THEN U_CURV ELSE U_CURV+U_CLOSE);
			END "FIT";

		;	⊃	relook;

		IF U_STATUS≥0 THEN IF ¬(U_ARGεU_BLOB) THEN
			PUT U_ARG IN U_COMP;

		END "CASE";
	END;
⊃	edge follower driver;

SET PROCEDURE GETEDGE(INTEGER CNT);
	BEGIN INTEGER I;
	SET FOO, TEMP, OLD;
	BOOLEAN RESCAN;
	LABEL LOOP;
	ITEMVAR ARG;
	FOO ← PHI;
	OLD ← U_BLOB;
	RESCAN ← FALSE;
	ARG ← IF CNT<0 THEN EVERY ELSE NIL;
LOOP:	DO	BEGIN 
		U_EDGBLB ← PHI;
		IF CNT<0 THEN ISSUE(DSEND+DKILL,"II","EDGE",
			MESSAGE XEQ("START",STAT_II));
		U_OUT "SENDING FIND "&PN(ARG) U_EOM;
		ISSUE(DSEND+DKILL,"II","EDGE",MESSAGE FIND(ARG));
		PROCESS_RESPONSE("FIND", CNT≥0);
		TEMP ← U_EDGBLB-FOO;
		FOO ← FOO∪U_EDGBLB;
		IF CNT∧U_STATUS=-1∧¬LENGTH(FOO) THEN
			BEGIN
			IF RESCAN THEN RETURN(FOO);
			RESCAN ← TRUE;
			ISSUE(DSEND+DKILL,"II","EDGE",
				MESSAGE XEQ("START",STAT_II));
			GO TO LOOP;
			END;
		WHILE LENGTH(TEMP) DO 
			BEGIN "UPDAT"
			FOR I←1 STEP 1 UNTIL U_BOINDEX DO
				IF U_BLOBS[I]=U_OBJS[I] THEN DONE;
			IF I>U_BOINDEX THEN
				BEGIN
				IF I>U_BOMAX THEN
					BEGIN
					OUTSTR("U_BOMAX OVERFLOW" U_C);
					RETURN(FOO);
					END;
				U_BOINDEX ← I;
				END;
			U_BLOBS[I] ← {LOP(TEMP)};
			U_OBJS[I] ← PHI;
			END;
		END UNTIL CNT≤0∨LENGTH(FOO-OLD)≥CNT;
	RETURN(FOO);
	END;
⊃   Curve and compact driver;

SET PROCEDURE CURVE(SET FOO);
	BEGIN INTEGER ITEMVAR BLOB;
	U_CURBLB ← PHI;
	IF ¬LENGTH(FOO) THEN RETURN(PHI);
	U_ALL(FOO,U_CURV);
	IF COP(FOO)=EVERY THEN
		BEGIN "ALL"
		U_OUT "SENDING FIT EVERY" U_EOM;
		ISSUE(DSEND+DKILL,"II","EDGE",MESSAGE FIT(EVERY));
		PROCESS_RESPONSE("FIT",FALSE);
		END "ALL" ELSE WHILE LENGTH(FOO) DO BEGIN "SET"
		BLOB ← LOP(FOO);
		IF BLOBεU_BLOB∧¬(U_GD(BLOB) LAND U_CURV) THEN
			BEGIN
			U_OUT "SENDING FIT "&PN(BLOB) U_EOM;
			ISSUE(DSEND+DKILL,"II","EDGE",MESSAGE FIT(BLOB));
			PROCESS_RESPONSE("FIT",TRUE);
			END;
		END "SET";
	IF LENGTH(REJ_ITEMS) THEN REJ_OBJ(PHI);
	RETURN(U_CURBLB);
	END;

⊃	compact driver;

SIMPLE PROCEDURE COMP(SET BLOBS);
	BEGIN INTEGER ITEMVAR BLOB;
	FOREACH BLOB|BLOBεBLOBS∧(¬(BLOBεU_COMP)) DO
		BEGIN
		ITVAR_II ← BLOB;
		U_OUT "SENDING COMPACT "&PN(BLOB) U_EOM;
		ISSUE(DSEND+DKILL,"II","EDGE",MESSAGE COMPACT(BLOB));
		IF BLOBε U_OBJ THEN U_ELIM(BLOB);
		END;
	IF LENGTH(REJ_ITEMS) THEN REJ_OBJ(PHI);
	END;
⊃	simple driver;

SET PROCEDURE SIMPL(SET BLOBS, OBJECTS; REFERENCE SET NO_REC);
	BEGIN SET RET, TMP;
	INTEGER ITEMVAR BLOB;
	INTEGER I;
	NO_REC ← RET ← PHI;
	WHILE LENGTH(BLOBS) DO
		BEGIN
		BLOB ← LOP(BLOBS);
		IF ¬(U_GD(BLOB) LAND U_SIMP)∧(U_GD(BLOB) LAND U_CURV) THEN
			BEGIN
			U_OUT "SENDING SIMP_FIT "&PN(BLOB) U_EOM;
			ISSUE(DSEND+DWAIT+DKILL,"II","SIMP",
				MESSAGE SIMP_FIT(BLOB,STAT_II,ITVAR_II←NIL));
			IF STAT_II THEN
				BEGIN
				IF ¬(EVERYεOBJECTS)∧(COP(GLOBAL
					INSTANCE`ITVAR_II)εOBJECTS) THEN
					REJ_OBJ({ITVAR_II});
				PUT BLOB IN NO_REC
				END ELSE BEGIN
				TMP ← GLOBAL INSTANCE`ITVAR_II;
				PUT ITVAR_II IN RET;
				U_PNGEN(ITVAR_II,PN(COP(TMP))&"_",U_OCNT);
				U_GD(BLOB)←U_GD(BLOB) LOR U_SIMP;
				FOREACH TEMP|GLOBAL FACE⊗ITVAR_II≡TEMP DO
					U_PNGEN(TEMP,"FACE_",U_FCNT);
				FOR I←1 STEP 1 UNTIL U_BOINDEX DO
					IF BLOBεU_BLOBS[I] THEN
					BEGIN
					PUT ITVAR_II IN U_OBJS[I];
					DONE;
					END;
				IF I>U_BOINDEX THEN OUTSTR("BLOB NOT IN "&
					"U_BLOBS AFTER SIMPLE" U_C);
				END;
			END;
		END;
	U_OBJ ← U_OBJ ∪ RET;
	RETURN(RET);
	END;
⊃	fine driver, just like curve;

SET PROCEDURE INNER(SET BLOBS);
	BEGIN INTEGER ITEMVAR BLOB;
	U_EDGBLB ← PHI;
	IF ¬LENGTH(BLOBS) THEN RETURN(PHI);
	U_ALL(BLOBS,U_CURV);
	IF COP(BLOBS)=EVERY THEN
		BEGIN
		U_OUT "SENDING FINE EVERY" U_EOM;
		ISSUE(DSEND+DKILL,"II","EDGE",MESSAGE FINE(EVERY));
		PROCESS_RESPONSE("FINE",FALSE);
		END ELSE WHILE LENGTH(BLOBS) DO BEGIN
		BLOB ← LOP(BLOBS);
		IF BLOBεU_BLOB∧¬(U_GD(BLOB) LAND U_CURV) THEN
			BEGIN
			U_OUT "SENDING FINE "&PN(BLOB) U_EOM;
			ISSUE(DSEND+DKILL,"II","EDGE",MESSAGE FINE(BLOB));
			PROCESS_RESPONSE("FINE",TRUE);
			END;
		END;
	RETURN(BLOBS∪U_EDGBLB);
	END;

⊃	camera changing routine;

SIMPLE BOOLEAN PROCEDURE CAMCHG(INTEGER COM,LENS; REAL X, Y, Z);
	BEGIN
	CAMFLG ← FALSE;
	IF ¬(0≤COM≤7∨COM=10) THEN RETURN(FALSE);
	IF COM<10 THEN
		BEGIN
		IF 0<LENS<3∧CAMLENS≠LENS THEN ISSUE(DSEND+DWAIT+DKILL
			,"II","CAM",MESSAGE CHNG_LENS(LENS));
		IF ¬COM∧¬LENS THEN ISSUE(DSEND+DWAIT+DKILL,"II","CAM",
			MESSAGE CAM_UPDATE);
		IF ¬CAMFLG∧(COM LAND 3) THEN
			ISSUE(DSEND+DWAIT+DKILL,"II","CAM",MESSAGE
			MOVE_CAM(IF COM LAND 1 THEN X ELSE CAMPAN,
			IF COM LAND 2 THEN Y ELSE CAMTIL));
		IF ¬CAMFLG∧(COM LAND 4) THEN
			ISSUE(DSEND+DWAIT+DKILL,"II","CAM",
			MESSAGE CHNG_FOCUS(Z));
		END ELSE ISSUE(DSEND+DWAIT,"II","CAM",
			MESSAGE CAM_CENTER(LENS,X,Y,Z));
	RETURN(¬CAMFLG);
	END;
⊃	verifier driver;

SIMPLE REAL PROCEDURE VERIF(INTEGER X1,Y1,X2,Y2);
	BEGIN
	ISSUE(DSEND+DWAIT+DKILL,"II","VERIFY",
		MESSAGE VERIFY(X1,Y1,X2,Y2,CONFID));
	RETURN(CONFID);
	END;

⊃	object rejection driver;


SIMPLE PROCEDURE REJ_OBJ(SET BLOBS);
	BEGIN INTEGER ITEMVAR BLOB, X;
	REJ_ITEMS ← REJ_ITEMS∪BLOBS;
	WHILE LENGTH(REJ_ITEMS) DO
		BEGIN
		BLOB ← LOP(REJ_ITEMS);
		IF BLOBε U_BLOB THEN
			BEGIN
			U_OUT "SENDING REJECT "&PN(BLOB) U_EOM;
			ISSUE(DSEND+DKILL,"II","EDGE",MESSAGE REJECT(BLOB));
			PROCESS_RESPONSE("REJECT",TRUE);
			END;
		IF BLOBεU_OBJ THEN
			BEGIN
			FOREACH X|GLOBAL FACE⊗BLOB≡X DO
				BEGIN
				U_DEL(CENTER⊗X);
				U_DEL(NORMAL⊗X);
				GLOBAL ERASE COLOR⊗X≡ANY;
				END;
			U_DEL(EDGES⊗BLOB);
			GLOBAL ERASE VISIBLE⊗BLOB≡ANY;
			GLOBAL ERASE FACE⊗BLOB≡ANY;
			GLOBAL ERASE INSTANCE⊗ANY≡BLOB;
			END;
		DISP_DEL({BLOB});
		U_RJEC(BLOB);
		DEL_PNAME(BLOB);
		GLOBAL DELETE(BLOB);
		END;
	END;
⊃	OLD COLOR DRIVER;

SET PROCEDURE COLGET(SET OBJS);
	BEGIN INTEGER COLNUM, I;
	SET FACES, OUTP, TEMP;
	ITEMVAR X;
	REAL ARRAY ITEMVAR Y;
	FACES ← OUTP ← PHI;
	FOREACH X,Y|XεOBJS∧GLOBAL VISIBLE⊗X≡Y∧(¬(GLOBAL COLOR⊗Y≡ANY)) DO
		BEGIN
		PUT Y IN FACES;
		PUT X IN OUTP;
		U_OUT "WANT COLOR FOR FACE "&PN(Y)&" OF "&PN(X) U_EOM;
		END;
	IF ¬LENGTH(FACES) THEN RETURN(PHI);
	COLNUM ← LENGTH(FACES);

		BEGIN ITEMVAR ARRAY FACE_COD[1:COLNUM];
		REAL ARRAY COORDS[1:2,1:COLNUM];

		MESSAGE PROCEDURE CLR_RESPONSE(INTEGER ITEMVAR ARRAY G);
			FOR I←1 STEP 1 UNTIL COLNUM DO
				BEGIN ; ⊃ SPROULL HACK !!!;
				GLOBAL MAKE COLOR⊗FACE_COD[I]≡G[I];
				U_OUT "COLOR⊗"&PN(FACE_COD[I])&"≡"&
					PN(G[I]) U_EOM;
				END;

		I ← 0;
		FOREACH X|XεFACES DO
			BEGIN
			TEMP ← GLOBAL CENTER⊗X;
			IF ¬LENGTH(TEMP) THEN
				OUTSTR("NO CENTER FOR "&PN(X) U_C) ELSE
				BEGIN
				Y ← LOP(TEMP);
				I ← I+1;
				COORDS[1,I] ← U_GD(Y)[1];
				COORDS[2,I] ← U_GD(Y)[2];
				FACE_COD[I] ← X;
				END;
			END;
		ISSUE(DSEND+DKILL,"II","COL",MESSAGE CLR_GET(COLNUM,COORDS));
		I←GET_ENTRY(DWAITM+DSOURCE+DDEST+DNAME,"COL","II",
			"CLR_RESPONSE");
		QUEUE(DACK+DACT,I);
		END;
	RETURN(OUTP);
	END;
⊃	NEW COLOR DRIVER;

BOOLEAN U_CINIT, U_INTCAL;

⊃  INITIALIZATION ROUTINE;

PROCEDURE INITCOL;
	BEGIN
	PRELOAD_WITH 299,50,50,199,0,0;
	SAFE OWN INTEGER ARRAY P[1:6];
	IF U_CINIT THEN RETURN;
	U_INTCAL ← FALSE;
	ISSUE(DSEND+DKILL,"II","COL",MESSAGE 
		COLOUR_INIT(P,10,TRUE, FALSE,FALSE));
	U_CINIT ← TRUE;
	END "INITCAL";

SET PROCEDURE GETCOL(SET OBJS);
	BEGIN INTEGER COLNUM, I;
	SET FACES, OUTP, TEMP;
	ITEMVAR X;
	REAL ARRAY ITEMVAR Y;
	IF ¬U_CINIT THEN INITCOL;
	IF ¬U_INTCAL THEN
		BEGIN "INIT"
		BOOLEAN FLG;
		INTEGER POINTS;

		MESSAGE PROCEDURE C_INIT(BOOLEAN FLAG; INTEGER PNTS);
			BEGIN
			FLG ← FLAG;
			POINTS ← PNTS;
			END;

		U_OUT "WAITING FOR INITCAL" U_EOM;
		I←GET_ENTRY(DWAITM+DSOURCE+DDEST+DNAME,"COL","II","C_INIT");
		QUEUE(DACK+DACT+DKILL,I);
		IF ¬FLG THEN
			BEGIN
			OUTSTR("COLOUR INITIALIZATION FAILED" U_C);
			RETURN(PHI);
			END;
		U_OUT CVS(POINTS)&" COLOR POINTS" U_EOM;
		END "INIT";
	IF ¬LENGTH(OBJS) THEN RETURN(PHI);
	FACES ← OUTP ← PHI;
	FOREACH X,Y|XεOBJS∧GLOBAL VISIBLE⊗X≡Y∧(¬(GLOBAL COLOR⊗Y≡ANY)) DO
		BEGIN "LOOP"
		PUT Y IN FACES;
		PUT X IN OUTP;
		U_OUT "WANT COLOR FOR FACE "&PN(Y)&" OF "&PN(X) U_EOM;
		END "LOOP";
	IF ¬LENGTH(FACES) THEN RETURN(PHI);
	COLNUM ← LENGTH(FACES);

		BEGIN "STORE"
		ITEMVAR ARRAY FACE_COD[1:COLNUM];
		SAFE INTEGER ARRAY COORDS[1:COLNUM,1:2];

		MESSAGE PROCEDURE COLOUR_RECEIVE(INTEGER PNTS;
				SAFE INTEGER ARRAY CM);
			BEGIN
			IF PNTS≠COLNUM THEN OUTSTR("COLOUR GOOFED" U_C);
			FOR I←1 STEP 1 UNTIL COLNUM DO
				BEGIN STRING C;
				ITEMVAR COL;
				INTEGER F;
				C ← CVXSTR(CM[I]);
				COL ← CVSI(C,F);
				IF F THEN
					BEGIN
					COL ← GLOBAL NEW;
					NEW_PNAME(COL,C);
					END;
				GLOBAL MAKE COLOR⊗FACE_COD[I]≡COL;
				U_OUT "COLOR⊗"&PN(FACE_COD[I])&"≡"&C U_EOM;
				END;
			END "COLOUR_RECEIVE";

		I ← 0;
		FOREACH X|XεFACES DO
			BEGIN
			TEMP ← GLOBAL CENTER⊗X;
			IF ¬LENGTH(TEMP) THEN
				OUTSTR("NO CENTER FOR "&PN(X) U_C) ELSE
				BEGIN
				Y ← LOP(TEMP);
				I ← I+1;
				COORDS[1,I] ← U_GD(Y)[1]+.5;
				COORDS[2,I] ← U_GD(Y)[2]+.5;
				FACE_COD[I] ← X;
				END;
			END;
		ISSUE(DSEND+DKILL,"II","COL",MESSAGE COLOUR(COLNUM,COORDS));
		I←GET_ENTRY(DWAITM+DSOURCE+DDEST+DNAME,"COL","II",
			"COLOUR_RECEIVE");
		QUEUE(DACK+DACT,I);
		END "STORE";
	RETURN(OUTP);
	END "GETCOL";
⊃	DISPLAY PROGRAMS;

PROCEDURE DISP_OBJ(SET OBJS; BOOLEAN FLAG);
	BEGIN SET DISP;
	REAL ARRAY ITEMVAR FOO, OBJ, CEN;
	INTEGER DFRAM, COUNT;
	REAL X, Y, I, X1, Y1, X2, Y2, XL, YL, T, B, L, R;
	FOREACH OBJ,FOO|OBJεOBJS∧GLOBAL EDGES⊗OBJ≡FOO DO
		BEGIN "OBJ" INTEGER ITEMVAR ZZZ;
		COUNT ← U_GD(FOO)[1,0];
		T ← L ← 500.0;
		B ← R ← 0;
		FOR I ← 1 STEP 1 UNTIL COUNT DO
			BEGIN
			X1 ← U_GD(FOO)[1,I];
			X2 ← U_GD(FOO)[3,I];
			Y1 ← U_GD(FOO)[2,I];
			Y2 ← U_GD(FOO)[4,I];
			IF X1<L THEN L←X1;
			IF X1>R THEN R←X1;
		 	IF X2<L THEN L←X2;
		 	IF X2>R THEN R←X2;
		 	IF Y1<T THEN T←Y1;
		 	IF Y2<T THEN T←Y2;
		 	IF Y1>B THEN B←Y1;
		 	IF Y2>B THEN B←Y2;
			END;
		IF T>256.0∨B<0∨L>333.0∨R<0 THEN RETURN;
		DISP ← U_DISP⊗OBJ;
		IF LENGTH(DISP) THEN
			BEGIN
			ZZZ←COP(DISP);
			DFRAM←DATUM(ZZZ);
			END ELSE BEGIN
			IF (DFRAM←GETPOG)<0 THEN RETURN;
			MAKE U_DISP⊗OBJ≡NEW(DFRAM);
			END;

			BEGIN "DISP"
			INTEGER ARRAY DBUF[1:COUNT*2+
				(IF FLAG THEN COUNT/2 ELSE 0)+20];
			DPYSET(DBUF);
			DPYBRT(7);
			DPYBIG(1);
			Y ← 0;
			FADCHG(0,0,AIVECT);
			FOR I←1 STEP 1 UNTIL COUNT DO
				BEGIN "EDGE"
				X1 ← U_GD(FOO)[1,I];
				X2 ← U_GD(FOO)[3,I];
				Y1 ← U_GD(FOO)[2,I];
				Y2 ← U_GD(FOO)[4,I];
				IF I=1∨XL≠X1∨YL≠Y1 THEN
					BEGIN
					FRDCHG(X1,Y1,RIVECT);
					IF Y1>Y THEN BEGIN Y←Y1;X←X1;END;
					END;
				FRDCHG(XL←X2,YL←Y2,RVECT);
				IF Y2>Y THEN BEGIN Y←Y2;X←X2;END;
				END "EDGE";
			IF FLAG THEN
				BEGIN "LABEL"
				FRDCHG(X-7,Y+5,RIVECT);
				DPYSST(PN(OBJ));
				FOREACH FOO|GLOBAL VISIBLE⊗OBJ≡FOO DO
					BEGIN "FACE"
					SET Z;
					LABEL L1;
					Z ← GLOBAL CENTER⊗FOO;
					IF LENGTH(Z) THEN CEN ← LOP(Z) ELSE
						BEGIN
						OUTSTR("DISP_OBJ - "&
							"VISIBLE FACE "&
							PN(FOO)&
							" HAS NO CENTER"
							U_C);
						GO TO L1;
						END;
					X1 ← U_GD(CEN)[1];
					Y1 ← U_GD(CEN)[2];
					FADCHG(X1-7,Y1-5,AIVECT);
					DPYSST(PN(FOO));
					DISP ← GLOBAL COLOR⊗FOO;
					IF LENGTH(DISP) THEN
						BEGIN
						FADCHG(X1-7,Y1+10,AIVECT);
						DPYSST(PN(COP(DISP)));
						END;
L1:					END;
				END "LABEL";
			END "DISP";
		DPYOUT(DFRAM);
		END "OBJ";
	END;
⊃	delete display;

PROCEDURE DISP_DEL(SET BLOBS);
	BEGIN INTEGER ITEMVAR X, Z;
	SET D;
	INTEGER ARRAY F[0:10];
	DPYSET(F);
	FOREACH X|XεBLOBS DO
		BEGIN
		D ← U_DISP⊗X;
		IF LENGTH(D) THEN
			BEGIN
			Z ← COP(D);
			RELPOG(DATUM(Z));
			ERASE U_DISP⊗X≡Z;
			END;
		END;
	END;

⊃	driver for updating world model after moving an object;

BOOLEAN PROCEDURE NEW_SIMP(REAL ARRAY ITEMVAR OBJ; REAL ARRAY TRANS);
	BEGIN SET X;
	INTEGER ITEMVAR DIS;
	X ← U_DISP⊗OBJ;
	IF LENGTH(X) THEN
		BEGIN
		DIS ← COP(X);
		IF 0≤DATUM(DIS)≤14 THEN DISP_DEL({OBJ});
		END;
	U_OUT "SENDING SIMP_UPDATE "&PN(OBJ) U_EOM;
	ISSUE(DSEND+DWAIT+DKILL,"II","SIMP",
		MESSAGE SIMP_UPDATE(OBJ,TRANS,STAT_II));
	IF STAT_II THEN RETURN(FALSE);
	IF OBJεU_COMP THEN
		ISSUE(DSEND+DKILL,"II","EDGE",MESSAGE COMPACT(OBJ));
	RETURN(TRUE);
	END;
⊃	this is the job setup program
	It's argument is the monitor's logical name for the ob from the list
	in U_DEFNAMES on page 1.  It will determine whether or not the job
	is logged in and, if not, output the proper command to the monitor;

SIMPLE INTEGER PROCEDURE JOB_START(STRING JOB);
	BEGIN INTEGER I, STRT;
	BOOLEAN TST, CHK;
	DEFINE EPSILON="1000";

	FOR I←1 STEP 1 UNTIL U_DEFMAX DO IF EQU(JOB,U_DEFNAMES[I]) THEN DONE;
	IF I>U_DEFMAX THEN BEGIN
		U_OUT JOB&" NOT RECOGNIZED - JOB_START" U_EOM;RETURN(-1);END;
	TST ← FALSE;
	DO 	BEGIN
		IF TST THEN CALL(4,"SLEEP");
		CHK ← CASE I-1 OF (YES_EDGE,
			YES_CUR,
			YES_SIMP,
			YES_CAM,
			YES_VER,
			YES_COL,
			YES_GUN,
			YES_EYE,
			YES_HAND,
			YES_MOVE,
			YES_SEG,
			YES_REC,
			YES_PRED);
		IF CHK THEN BEGIN U_OUT JOB&" READY" U_EOM;RETURN(1);END;
		IF ¬TST THEN
			BEGIN
			TST ← TRUE;
			IF RUN THEN
				BEGIN
				ISSUE(DSEND+DKILL,"II","TRACE",
					MESSAGE MON_COM(":"&JOB&"RUN"));
				STRT ← CALL(0,"RUNTIME");
				CALL(6,"SLEEP");
			END ELSE BEGIN
				STRT ← 0;
				OUTSTR("NO MONITOR-LOAD JOB YOURSELF" U_C);
				CALL(10,"SLEEP");
				END;
			END;
		END UNTIL STRT∧(CALL(0,"RUNTIM")-STRT)>EPSILON;
	U_OUT JOB&" DID NOT INIT IN REQUIRED TIME" U_EOM;
	RETURN(0);
	END;
⊃	this is the initialization routine for
	the utility routines. It must be called before they are.
	It generates printnames for all global items in use,
	initializes arrays and variables, initializes the
	display routines and page printer, and sets
	second segment flags for this job;

SIMPLE PROCEDURE U_INIT;
	BEGIN INTEGER I;
	EXTERNAL PROCEDURE DPYCLR;
	U_FCNT ← U_BCNT ← U_OCNT ← U_BOINDEX ← 0;
	U_BLOB ← U_OBJ ← PHI;
	DPYCLR;
	DPYTYP(-180,10,1);
	GDISP_INIT ← FALSE;
	OUTSTR(NULL U_C U_C U_C U_C U_C U_C U_C U_C U_C U_C U_C);
	PUT_DATA(0,0,"II");
	YES_II ← TRUE;
	U_OUT "UTILITY ROUTINES INITIALIZED" U_EOM;
	END;

⊃	this initializes the TABLE array in the world model the first time
	called. Routines which update or use TABLE should not do so unless
	TAB_INIT is TRUE;

SIMPLE PROCEDURE TAB_SET;
	BEGIN INTEGER I, J, K, L;
	GETFORMAT(K,L);
	SETFORMAT(0,0);
	IF ¬TAB_INIT THEN FOR I←0 STEP 1 UNTIL 11 DO
	   FOR J←0 STEP 1 UNTIL 19 DO
		BEGIN
		TAB_INIT ← TRUE;
		TABLE[I,J] ← GLOBAL NEW(0);
		NEW_PNAME(TABLE[I,J],"TABLE_"&CVS(I)&"_"&CVS(J));
		END;
	SETFORMAT(K,L);
	END;